Personal Computer World 2006 May/PCWMAY06.iso/Software/Resources/PaperCut Quota 6.1/pc-setup.exe/{app}/WebAdmin/includes/PCCommon.inc

Text File | 2006-01-02 | 17KB | 551 lines

<% Option Explicit
    ' (c) Copyright 1999-2004 PaperCut Software Pty. Ltd.

    Response.Buffer = True
    Response.CacheControl = "No-cache"

    Dim gstrPageTitle
    Dim gstrProduct
    Dim gstrLoggedInUser
    Dim gstrErrorMessage
    Dim gblnHasChargeBack
    Dim gblnHasNetCharging
    Dim gblnIsLoggedIn
    Dim gblnIsAdmin
    Dim gblnIsAdminOnlyPage

    Dim gblnShowUserPrintLog
    Dim gblnShowUserNetLog
    Dim gblnShowUserTransactionLog
    Dim gblnShowTransferOption
    Dim gblnShowUserNetUsageTotals
    Dim gblnEnableTopUpCards
    Dim gblnAlwaysShowAdminLink
    Dim gblnAllowAnonymousAccess
    Dim gblnShowChargeRates

    ' setup defaults
    gblnShowUserPrintLog = True
    gblnShowUserNetLog = True
    gblnShowUserTransactionLog = True
    gblnShowTransferOption = True
    gblnShowUserNetUsageTotals = False
    gblnEnableTopUpCards = True
    gblnAlwaysShowAdminLink = True
    gblnAllowAnonymousAccess = False
    gblnShowChargeRates = True ' Default to showing charge rates

    Dim garrChargeTypes
    Dim gblnShowCurrency
    Dim gblnRegistered
    Dim gblnTrialExpired
    Dim gstrUnregisteredMsg
    Dim gstrLicensedTo
    Dim gstrVersion

    Dim gobjLangText
    Dim garrValidLangs
    Dim gstrActiveLang

    Dim gstrScriptName
    Set gobjLangText = Server.CreateObject("Scripting.Dictionary")


    ' TRANSLATORS: Modify this line to include all languages that the web tools have been translated into
    garrValidLangs = Array("en", "es", "it", "fr", "ko", "nl", "zh-hk", "zh-tw", "zh-sg", "zh-cn", "zh", "de", "ja")


    ' Detect language (defaults to "en" if we don't have another match)
    AutoDetectLanguage()

    'Include the lang files before we need them
%>
<!-- #include file="lang_en.inc" -->
<!-- #include file="Config.inc" -->


<% ' TRANSLATORS: Insert your language file below %>
<!-- #include file="lang_it.inc" -->
<!-- #include file="lang_es.inc" -->
<!-- #include file="lang_fr.inc" -->
<!-- #include file="lang_de.inc" -->
<!-- #include file="lang_ko.inc" -->
<!-- #include file="lang_nl.inc" -->
<!-- #include file="lang_zh-hk.inc" -->
<!-- #include file="lang_zh-cn.inc" -->
<!-- #include file="lang_ja.inc" -->



<%
    gstrScriptName = Request.ServerVariables("SCRIPT_NAME")
    If InStr(1, gstrScriptName, "/Admin.asp", vbTextCompare) > 0 Or _
            InStr(1, gstrScriptName, "/UserList.asp", vbTextCompare) > 0 Or _
            InStr(1, gstrScriptName, "/LogReport.asp", vbTextCompare) > 0 Or _
            InStr(1, gstrScriptName, "/OtherCharges.asp", vbTextCompare) > 0 Or _
            InStr(1, gstrScriptName, "/AccountList.asp", vbTextCompare) > 0 Or _
            InStr(1, gstrScriptName, "/AccountDetails.asp", vbTextCompare) > 0 Then

        ' Only Administrators can run the above these files
        gblnIsAdminOnlyPage = True
        Session("IsAdmin") = True

    End If

    Sub SetActiveLanguage(strLang)
        gstrActiveLang = Trim(LCase(strLang))
    End Sub

    Function IsActiveLanguage(strLang)
        IsActiveLanguage = (gstrActiveLang = Trim(LCase(strLang))) or (Trim(LCase(strLang)) = "en")
    End Function

    Sub SetText(strName, strValue)
        gobjLangText(strName) = strValue '& " (T)"
    End Sub

    Sub AutoDetectLanguage()
        On Error Resume Next
        Dim strLang
        Dim arrAccept
        Dim i,j
        strLang = "en"    ' the default
        arrAccept = Split(Replace(Request("HTTP_ACCEPT_LANGUAGE"), ";", ","), ",")
        For i = UBound(arrAccept) to 0 Step -1
            If Left(arrAccept(i), 2) <> "q=" Then
                For j = 0 to UBound(garrValidLangs)
                    If LCase(Left(arrAccept(i), Len(garrValidLangs(j)))) = LCase(garrValidLangs(j)) Then
                        strLang = garrValidLangs(j)
                    End If
                Next
            End if
        Next
        gstrActiveLang = strLang
    End Sub

    Function IsPreferredLanguage()
        If LCase(Left(Request("HTTP_ACCEPT_LANGUAGE"), Len(gstrActiveLang))) = gstrActiveLang Then
            IsPreferredLanguage = True
        Else
            IsPreferredLanguage = False
        End If
    End Function

    Function HTMLEncodeIfRequired(strInput)
        Dim strCharset
        strCharset = GetTextNoEncode("charset")

        If strCharset <> "big5" and strCharset <> "euc-kr" and strCharset <> "Shift_JIS" Then
            HTMLEncodeIfRequired = Server.HTMLEncode(strInput)
        Else
            HTMLEncodeIfRequired = strInput
        End If
    End Function

    Function GetText(strName)
        GetText = HTMLEncodeIfRequired(GetTextNoEncode(strName))
    End Function

    Function GetTextNoEncode(strName)
        If gobjLangText.Exists(strName) Then
            GetTextNoEncode = gobjLangText(strName)
        Else
            GetTextNoEncode = "'" & strName & "' untranslated"
        End If
    End Function

    Function GetTextReplace(strName, arrReplace)
        If gobjLangText.Exists(strName) Then
            Dim s, i
            s = gobjLangText(strName)

            For i = 0 to UBound(arrReplace)
                s = Replace(s, "%" & i & "%", arrReplace(i))
            Next
            GetTextReplace = HTMLEncodeIfRequired(s)
        Else
            GetTextReplace = "'" & strName & "' untranslated"
        End If
    End Function

    Function HasText(strName)
        HasText = gobjLangText.Exists(strName)
    End Function

    ' START RESULT SET NAVIGATION
    Const mintRECORDS_PER_PAGE = 50
    Const mintPAGES_PER_NAV_BLOCK = 10

    Function GetCurrentPage(intCurrentRecord)
        GetCurrentPage = ((intCurrentRecord-1) \ mintRECORDS_PER_PAGE) + 1
    End Function

    Function GetStartRecord(intPage, intTotalRecords)
        GetStartRecord = ((intPage-1) * mintRECORDS_PER_PAGE) + 1

        if (GetStartRecord > intTotalRecords) then
            GetStartRecord = intTotalRecords
        end if
    End Function

    Function GetTotalPages(intTotalRecords)
        GetTotalPages = ((intTotalRecords-1) \ mintRECORDS_PER_PAGE) + 1
    End Function

    Function Max(intA, intB)
        if (intA >= intB) then
            Max = intA
        Else
            Max = intB
        End if
    End Function

    Function Min(intA, intB)
        if (intA <= intB) then
            Min = intA
        Else
            Min = intB
        End if
    End Function

    Sub DisplayPrintJobStatus(strStandardStatus, strUserName, curAmount, lngJobEntryID, bIsRefunded, bIsCancelled, bIsDenied)
        ' Sub out any english words if not english
        If Not gstrActiveLang = "en" Then
            strStandardStatus = Replace(strStandardStatus, "Printed", GetText("Printed"))
            strStandardStatus = Replace(strStandardStatus, "Denied", GetText("Denied"))
            strStandardStatus = Replace(strStandardStatus, "Cancelled", GetText("Cancelled"))
            strStandardStatus = Replace(strStandardStatus, "Refunded", GetText("Refunded"))
        End If
        if Not gblnIsAdmin Then
            ' Just write out standard status as we are a standard user.
            Response.Write strStandardStatus
        Else
            If bIsCancelled And Not bIsRefunded Then
                Response.Write "<b>"
            End If
            Response.Write strStandardStatus
            If curAmount > 0 and Not (bIsRefunded or bIsDenied) Then
                Response.Write " " & "[<a href=""javascript:decisionLink('"
                Dim strConfirmMsg
                strConfirmMsg = GetText("RefundConfirm")
                strConfirmMsg = Replace(strConfirmMsg, "%0%", strUserName)
                strConfirmMsg = Replace(strConfirmMsg, "%1%", FormatCredit(curAmount))
                Response.Write strConfirmMsg
                Response.Write "', 'UserList.asp?cmd=refund"
                Response.Write "&strUserName=" & Server.UrlEncode(strUserName)
                Response.Write "&curAmount=" & curAmount
                Response.Write "&lngJobEntryID=" & lngJobEntryID
                Response.Write "')"">" & GetText("Refund") & "</a>]"
            End If
            If bIsCancelled And  Not bIsRefunded Then
                Response.Write "</b>"
            End If
        End If
    End Sub

    Sub DisplayPageNavigation(strURL, intStartRecord, intTotalRecords)
        Dim intTotalPages
        Dim intCurrentPage
        Dim intPage
        Dim intStartPage
        Dim intEndPage
        Dim intTotalNavBlocks
        Dim intCurrentNavBlock

        intTotalPages = GetTotalPages(intTotalRecords)
        intCurrentPage = GetCurrentPage(intStartRecord)
        intTotalNavBlocks = ((intTotalPages-1) \ mintPAGES_PER_NAV_BLOCK) + 1
        intCurrentNavBlock = ((intCurrentPage-1) \ mintPAGES_PER_NAV_BLOCK) + 1
        intStartPage = Max(1, (intCurrentNavBlock-1) * mintPAGES_PER_NAV_BLOCK + 1)
        intEndPage = Min(intTotalPages, (intCurrentNavBlock) * mintPAGES_PER_NAV_BLOCK)


        'intStartPage = Max(1, intCurrentPage / (intTotalPages \ mintMAX_NAV_PAGES)
        Response.Write GetText("Pages") & ": "

        If Instr(strURL, "javascript:") > 0 Then
            ' Do not touch....
        ElseIf Instr(strURL, "?") <= 0 Then
            strURL = strURL & "?intStartRecord=%intStartRecord%"
        ElseIf Right(strURL, 1) <> "&" Then
            strURL = strURL & "&intStartRecord=%intStartRecord%"
        End If


        If (intCurrentNavBlock > 1) then
            Response.Write BuildNavLink(strURL, "<<" & GetText("Previous"), GetStartRecord(intCurrentPage-mintPAGES_PER_NAV_BLOCK, intTotalRecords)) & " "
            Response.Write BuildNavLink(strURL, "1", 1) & " ... "
            'Response.Write "<A HREF=""" & BuildNavURL(strURL, GetStartRecord(intCurrentPage-mintPAGES_PER_NAV_BLOCK, intTotalRecords))  & """><<" & GetText("Previous") & "</A> "
        End If

        for intPage = intStartPage to intEndPage
            if (intPage = intCurrentPage) then
                Response.Write "<B>" & intPage & "</B> "
            else
                Response.Write BuildNavLink(strURL, CStr(intPage), GetStartRecord(intPage, intTotalRecords)) & " "
                'Response.Write "<A HREF=""" & BuildNavURL(strURL, GetStartRecord(intPage, intTotalRecords)) & """>" & intPage & "</A> "
            end if
        Next

        If (intCurrentNavBlock < intTotalNavBlocks) then
            Response.Write " ... " & BuildNavLink(strURL, CStr(intTotalPages), (intTotalPages-1) * mintRECORDS_PER_PAGE + 1) & " "
            Response.Write BuildNavLink(strURL, GetText("Next") & ">>", GetStartRecord(intCurrentPage+mintPAGES_PER_NAV_BLOCK, intTotalRecords)) & " "
            'Response.Write "<A HREF=""" & BuildNavURL(strURL, GetStartRecord(intCurrentPage+mintPAGES_PER_NAV_BLOCK, intTotalRecords)) & """>" & GetText("Next") & ">></A> "
        End If

        'Response.Write "<BR>Total Records: " & intTotalRecords
        'Response.Write "<BR>Total Pages: " & intTotalPages
        'Response.Write "<BR>Current Page: " & intCurrentPage
        'Response.Write "<BR>Total Nav Blocks: " & intTotalNavBlocks
        'Response.Write "<BR>Current Nav Block: " & intCurrentNavBlock
        'Response.Write "<BR>Start Page: " & intStartPage
        'Response.Write "<BR>End Page: " & intEndPage

    End Sub

    Function BuildNavLink(strURLTemplate, strLinkText, intStartRecord)
        BuildNavLink = "<A HREF=""" & Replace(strURLTemplate, "%intStartRecord%", intStartRecord) & """>" & strLinkText & "</A>"
    End Function

    ' END RESULT SET NAVIGATION

    Function FormatCredit(creditValue)
        If gblnShowCurrency Then
            FormatCredit = FormatCurrency(creditValue)
        Else
            FormatCredit = FormatNumber(creditValue)
        End If
    End Function

    function eschtml(s)
        dim h
        h = s
        h = replace(h, "&", "&")
        h = replace(h, "<", "<")
        h = replace(h, ">", ">")
        h = replace(h, """", """)
        eschtml = h
    end function

    Function StripDomainFromUser(strUser)
        Dim s
        s = Replace(strUser, "/", "\")
        Dim pos
        pos = InStr(1, s, "\", vbBinaryCompare)
        if pos > 0 Then
            s = Trim(Mid(s, pos + 1, 255))
        End If

        StripDomainFromUser = s
    End Function

    Sub RedirectWithMessage(strURL, strMsg)
        Dim s

        If InStr(strURL, "?") > 0 Then
            s = strURL & "&strMessage=" & Server.URLEncode(strMsg)
        Else
            s = strURL & "?strMessage=" & Server.URLEncode(strMsg)
        End If

        Response.Redirect s
    End Sub

    Sub WriteErrorMessage(strMessage)
        Response.Write "<DIV class=""webAdminMessage"">" & strMessage & "</DIV>"
    End Sub

    Function RowClassHelper(intCount)
        If intCount mod 2 = 0 then
            RowClassHelper = "evenRow"
        else
            RowClassHelper = "oddRow"
        end if
    End Function

    Sub WriteUserAdminLinks(strUser)
        If strUser = "" Then
            Exit Sub
        End If

        Dim strUserEncoded
        Dim s
        strUserEncoded = Server.URLEncode(strUser)
        Response.Write "<DIV style=""padding-bottom: 10px; padding-top: 10px;"">"

        If gblnIsAdmin and InStr(1, Request.ServerVariables("SCRIPT_NAME"), "userlist.asp", vbTextCompare) = 0 Then
            Response.Write "<a href=""UserList.asp?strUserName=" & strUserEncoded & """>" & GetTextReplace("ModifyUserCredit", Array(strUser)) & ".</a> "
        End If

        If gblnIsAdmin Or gblnShowUserPrintLog Then
            s = "<a href=""Log.asp?strUserName=" & strUserEncoded & """>" & GetText("PrintJobs") & "</a>"
        End If

        If gblnHasNetCharging and (gblnIsAdmin Or gblnShowUserNetLog) Then
            s = s & ", <a href=""NetLog.asp?strUserName=" & strUserEncoded & """>" & GetText("NetUsage") & "</a>"
        End If

        If gblnIsAdmin Or gblnShowUserTransactionLog Then
            s = s & ", <a href=""TransLog.asp?strUserName=" & strUserEncoded & """>" & GetText("TransactionHistory") & "</a>"
        End If

        If gblnIsAdmin Then
            s = s & ", <a href=""LogReport.asp?txtUsername=" & strUserEncoded & """>" & GetText("AdhocReports") & "</a>"
        End If

        If s <> "" Then
            Response.Write GetTextReplace("ViewUserLogs", Array(strUser)) & ": " & s & "."
        End If

        Response.Write "</DIV>"
    End Sub

    Sub ExportToExcel(strFileName, oRS, blnTranslateFieldNames)
        Dim i
        Response.Clear
        Response.CacheControl = ""
        Response.ContentType = "application/vnd.ms-excel"
        Response.AddHeader "content-disposition","attachment; filename=" & strFileName & ".xls"
        Response.Write "<table border=""1"">"

        Response.Write "<tr>"
        For i = 0 to oRS.Fields.Count - 1
            If blnTranslateFieldNames Then
                Response.Write FormatExcelValue(GetText(oRS.Fields(i).Name))
            Else
                Response.Write FormatExcelValue(oRS.Fields(i).Name)
            End If
        Next
        Response.Write "</tr>"

        Do While Not oRS.EOF
            Response.Write "<tr>"
            For i = 0 to oRS.Fields.Count - 1
                Response.Write FormatExcelValue(oRS.Fields(i).Value)
            Next
            Response.Write "</tr>"
            oRS.MoveNext
        Loop
        Response.Write "</table>"
    End Sub

    Function FormatExcelValue(sVal)
        If IsNull(sVal) Then
            FormatExcelValue = "<td></td>"
        Else
            FormatExcelValue = "<td>" & Server.HTMLEncode(sVal) & "</td>"
        End If
    End Function

    Function GetVersionCheckURL()
        Dim objS
        Set objS = Server.createobject("PCWebAdmin.PCSettings")
        GetVersionCheckURL = objS.WebVersionCheckURL
        Set objS = Nothing
    End Function


    ' Load settings from the settings object
    Dim objSettings
    Set objSettings = Server.createobject("PCWebAdmin.PCSettings")
    gblnHasChargeBack = objSettings.HasEnterprise
    gblnHasNetCharging = objSettings.HasNetCharging
    gstrVersion = objSettings.PaperCutVersion
    gblnIsAdmin = Session("IsAdmin")
    gblnShowCurrency = objSettings.WebShowCurrency

    ' Set default page titles
    If gblnHasChargeBack then
        gstrProduct = "PaperCut Enterprise"
    Else
        gstrProduct = "PaperCut Quota"
    End If

    If gblnHasChargeBack Then
        ' If you have chargeback, then can't have net/topup, transfer options or charge rates
        gblnShowUserNetLog = False
        gblnShowTransferOption = False
        gblnEnableTopUpCards = False
        gblnShowChargeRates = False
    End If

    gblnRegistered = objSettings.IsRegistered
    gblnTrialExpired = objSettings.TrialExpired

    If gblnRegistered Then
        gstrUnregisteredMsg = ""
        gstrLicensedTo = GetText("LicensedTo") & ": " & objSettings.RegistrationName & "."
    Else
        If gblnTrialExpired Then
            gstrUnregisteredMsg = GetText("PaperCutTrial") & ". " & GetText("TrialExpired") & "."
        Else
            gstrUnregisteredMsg = GetText("PaperCutTrial") & ". " & GetTextReplace("TrialDaysRemaining", Array(objSettings.TrialDaysRemaining)) & "."
        End If
        gstrLicensedTo = gstrUnregisteredMsg
    End If
    Set objSettings = Nothing


    gstrPageTitle = GetText("WebTools")

    If Session("Username") = "" Then
        ' First try the IIS authentication details
        gstrLoggedInUser = StripDomainFromUser(Request.ServerVariables("LOGON_USER"))

        If gblnAllowAnonymousAccess and gstrLoggedInUser = "" and Not gblnIsAdminOnlyPage Then
            ' We're allowed to do anon login, and we have no IIS authentication details
            ' And this is not an admin page (never allow admin pages to be accessed with anon access)

            gstrLoggedInUser = Session("AnonUsername")
            if gstrLoggedInUser = "" And InStr(1, gstrScriptName, "/Logon.asp", vbTextCompare) = 0 Then
                ' Not logged in and not the logon page, so redirect to the logon page
                Response.Redirect "Logon.asp"
            End If

        End If

        ' Save the logged on user in the session
        Session("Username") = gstrLoggedInUser
    Else
        ' The user logged in previously

        gstrLoggedInUser = StripDomainFromUser(Request.ServerVariables("LOGON_USER"))
        If gstrLoggedInUser <> "" Then
            ' The IIS authentication value should always override any anonymous login
            Session("AnonUsername") = ""
            Session("Username") = gstrLoggedInUser
        Else
            ' Use username in the session
            gstrLoggedInUser = Session("Username")
        End If

    End If

    If gstrLoggedInUser = "" Then
        ' Not logged in
        gblnIsLoggedIn = False
        gstrLoggedInUser = GetText("NotLoggedIn")
    Else
        gblnIsLoggedIn = True
    End If
    gstrErrorMessage = Trim(Request("strMessage"))


    If Session("AnonUsername") <> "" Then
        ' Anon login

        ' Do not allow access to the transfer page
        gblnShowTransferOption = False

        If gblnIsAdminOnlyPage Then
            ' Never allow anonymous users to access admin pages
            Session("IsAdmin") = False
            gblnIsAdmin = False
            WriteErrorMessage GetText("ErrorAnonAdminAccess")
            Response.End
        End If
    End If


%>